home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mymem1 / mymemry.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  12.2 KB  |  327 lines

  1. '  User Profile Routines (from WINAPI.TXT)
  2. Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
  3. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  4. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  5.  
  6. Sub BuildSquare (X As Integer, Y As Integer)
  7. 'X and Y are pixel offsets
  8. 'A button has left and top lighter and right and bottom darker than middle
  9. 'outside shading is two pixels wide
  10.  
  11.     MyMemory.Line (X, Y)-(X + SquareSize - 1, Y), WHITE
  12.     MyMemory.Line (X, Y)-(X, Y + SquareSize - 1), WHITE
  13.     MyMemory.Line (X + SquareSize - 1, Y + SquareSize - 1)-(X + SquareSize - 1, Y), GRAY_MEDIUM
  14.     MyMemory.Line (X + SquareSize - 1, Y + SquareSize - 1)-(X, Y + SquareSize - 1), GRAY_MEDIUM
  15.     MyMemory.Line (X + 1, Y + 1)-(X + SquareSize - 2, Y + 1), WHITE
  16.     MyMemory.Line (X + 1, Y + 1)-(X + 1, Y + SquareSize - 2), WHITE
  17.     MyMemory.Line (X + SquareSize - 2, Y + SquareSize - 2)-(X + SquareSize - 2, Y + 1), GRAY_MEDIUM
  18.     MyMemory.Line (X + SquareSize - 2, Y + SquareSize - 2)-(X + 1, Y + SquareSize - 2), GRAY_MEDIUM
  19. 'now clear middle in case an item was displayed
  20.     MyMemory.Line (X + 2, Y + 2)-(X + SquareSize - 3, Y + SquareSize - 3), GRAY_LIGHT, BF
  21. End Sub
  22.  
  23. Sub ClearAllScores ()
  24.     MousePointer = HOURGLASS
  25.     For I% = 0 To 5
  26.         For J% = 0 To 2
  27.             If ScoreArray(I%, J%) <> NoScore Then
  28.                 ScoreArray(I%, J%) = NoScore
  29.                 If SaveFile <> SelectSaveFileNo Then
  30.                     ScoreArrayName(I%, J%) = ""
  31.                     KeyWord$ = "Score" + LTrim$(Str$(I% * 2 + 8)) + "x" + LTrim$(Str$(J% * 2 + 6))
  32.                     Temp% = WritePrivateProfileString(SelectHeader, KeyWord$, "", IniFile)
  33.                     KeyWord$ = KeyWord$ + "Name"
  34.                     Temp1% = WritePrivateProfileString(SelectHeader, KeyWord$, "", IniFile)
  35.                     If Temp% = 0 Or Temp1% = 0 Then
  36.                         MsgBox "Error Writing Scores", MB_OK, "Profile Error"
  37.                         Exit Sub
  38.                     End If
  39.                 End If
  40.             End If
  41.         Next J%
  42.     Next I%
  43.     MyMemory.FieldDesc.Caption = "Field is " + LTrim$(Str$(NumberXSquares)) + "x" + LTrim$(Str$(NumberYSquares)) + "    Score to Beat: None"
  44.     MousePointer = DEFAULT
  45. End Sub
  46.  
  47. Sub GetMyProfile ()
  48.  
  49.     Temp1% = GetPrivateProfileInt(SelectHeader, "NumberXSquares", -1, IniFile)
  50.     Temp2% = GetPrivateProfileInt(SelectHeader, "NumberYSquares", -1, IniFile)
  51.     Temp3% = GetPrivateProfileInt(SelectHeader, "SquareSize", -1, IniFile)
  52.     Temp4% = GetPrivateProfileInt(SelectHeader, "Timer", -1, IniFile)
  53.     Temp5% = GetPrivateProfileInt(SelectHeader, "SaveBestScore", -1, IniFile)
  54.  
  55.     GetScores
  56.  
  57.     Msg$ = "A Profile has been found in: " + IniFile + NL + NL
  58.     Msg$ = Msg$ + "The following settings are asked for:" + NL
  59.     Msg$ = Msg$ + "  NumberXSquares = " + Str$(Temp1%) + NL
  60.     Msg$ = Msg$ + "  NumberYSquares = " + Str$(Temp2%) + NL
  61.     Msg$ = Msg$ + "  SquareSize = " + Str$(Temp3%) + NL
  62.     Msg$ = Msg$ + "  Timer = " + Str$(Temp4%) + NL
  63.     Msg$ = Msg$ + "  SaveBestScore = " + Str$(Temp5%)
  64.     MsgBox Msg$, MB_OK, "MyMemory Game Setup"
  65.  
  66.     PF$ = "Profile Error"
  67.     TempE% = False
  68.  
  69.     Select Case Temp1%
  70.         Case 8, 10, 12, 14, 16, 18
  71.             NumberXSquares = Temp1%
  72.         Case Else
  73.             TempE% = True
  74.     End Select
  75.  
  76.     Select Case Temp2%
  77.         Case 6, 8, 10
  78.             NumberYSquares = Temp2%
  79.         Case Else
  80.             TempE% = True
  81.     End Select
  82.  
  83.     Select Case Temp3%
  84.         Case 32, 40, 48
  85.             SquareSize = Temp3%
  86.         Case Else
  87.             TempE% = True
  88.     End Select
  89.  
  90.     Select Case Temp4%
  91.         Case 1 To 5
  92.             SetTimer = Temp4%
  93.         Case Else
  94.             TempE% = True
  95.     End Select
  96.  
  97.     Select Case Temp5%
  98.         Case CHECKED, UNCHECKED
  99.             SaveScore = Temp5%
  100.         Case Else
  101.             TempE% = True
  102.     End Select
  103.  
  104.     If TempE% = True Then
  105.         'Indicate change so we can correct setup on exit
  106.         SaveFileChange = True
  107.         'Default Values already in variables
  108.         MsgBox "Illegal value in profile has been reset to default", MB_OK, PF$
  109.     End If
  110.  
  111. 'Check for valid combinations
  112.  
  113.     Msg1$ = "Invalid Field Size resetting to defaults"
  114.     
  115.     If NumberXSquares < 12 Then
  116.         FieldY% = (FormLabel * 3) + (FormHeader / TwipsPerPixel)
  117.     Else
  118.         FieldY% = (FormLabel * 2) + (FormHeader / TwipsPerPixel)
  119.     End If
  120.  
  121.     If (SquareSize * NumberXSquares >= ScreenPixelSizeX) Or (SquareSize * NumberYSquares + FieldY% >= ScreenPixelSizeY) Then
  122.         SquareSize = DefaultSquareSize
  123.         NumberXSquares = DefaultXSquares
  124.         NumberYSquares = DefaultYSquares
  125.         MsgBox Msg1$, MB_OK, PF$
  126.     End If
  127.     
  128. End Sub
  129.  
  130. Sub GetScores ()
  131. 'Get any scores from ini file
  132.     For X% = 8 To 18 Step 2
  133.         For Y% = 6 To 10 Step 2
  134.             Xa% = (X% - 8) / 2
  135.             Ya% = (Y% - 6) / 2
  136.             KeyWord$ = "Score" + LTrim$(Str$(X%)) + "x" + LTrim$(Str$(Y%))
  137.             ScoreArray(Xa%, Ya%) = GetPrivateProfileInt(SelectHeader, KeyWord$, NoScore, IniFile)
  138.             If ScoreArray(Xa%, Ya%) = 0 Then ScoreArray(Xa%, Ya%) = NoScore
  139.             KeyValue$ = Space$(255)
  140.             KeyWord$ = KeyWord$ + "Name"
  141.             MyGet% = GetPrivateProfileString(SelectHeader, KeyWord$, "N/A", KeyValue$, Len(KeyValue$), IniFile)
  142.             ScoreArrayName(Xa%, Ya%) = Mid$(KeyValue$, 1, MyGet%)
  143.         Next Y%
  144.     Next X%
  145. End Sub
  146.  
  147. Sub InitField ()
  148. 'Tell user to wait
  149.     MyMemory.MousePointer = HOURGLASS
  150.  
  151. 'Reset status variables
  152.     CurrentSquare = 0
  153.     CurrentSquare1 = 0
  154.     CurrentMoves = 0
  155.     CurrentSolved = 0
  156.  
  157. 'Enter Scene pointers, 2 each on the field
  158. ' also Reset squares to closed
  159.     Scene% = 0
  160.     For X% = 0 To (NumberXSquares - 1)
  161.         For Y% = 0 To (NumberYSquares - 1)
  162.             'Reset square to closed
  163.             SquareStatusArray(X%, Y%) = SquareClosed
  164.             'Set scene value
  165.             SquareSceneArray(X%, Y%) = Scene%
  166.             'If half way thru array, repeat scenes
  167.             If Scene% < ((NumberXSquares * NumberYSquares) / 2 - 1) Then
  168.                 Scene% = Scene% + 1
  169.             Else
  170.                 Scene% = 0
  171.             End If
  172.         Next Y%
  173.     Next X%
  174.  
  175. 'Now Shuffle each address scene 3 times
  176.     Randomize
  177.     For I% = 1 To 3
  178.         For X% = 0 To (NumberXSquares - 1)
  179.             For Y% = 0 To (NumberYSquares - 1)
  180.                 RndX% = Int(NumberXSquares * Rnd)
  181.                 RndY% = Int(NumberYSquares * Rnd)
  182.                 TempScene% = SquareSceneArray(RndX%, RndY%)
  183.                 SquareSceneArray(RndX%, RndY%) = SquareSceneArray(X%, Y%)
  184.                 SquareSceneArray(X%, Y%) = TempScene%
  185.             Next Y%
  186.         Next X%
  187.     Next I%
  188.  
  189. 'Build Field of squares, X and Y are now pixel offsets
  190.     'Don't paint screen twice, MyMemory Form will be painted
  191.     'if not active by its Form_Paint routine
  192.     If Screen.ActiveForm.Tag = "MyMemory" Then
  193.         For X% = 0 To ((NumberXSquares - 1) * SquareSize) Step SquareSize
  194.             For Y% = 0 To ((NumberYSquares - 1) * SquareSize) Step SquareSize
  195.                 BuildSquare X%, Y%
  196.             Next Y%
  197.         Next X%
  198.     End If
  199.  
  200. 'Initialize labels and Tell User we're ready
  201.     FieldStatus = FieldReady
  202.     MyMemory.LabelFieldStatus.Caption = ""
  203.     MyMemory.LabelSquareStatus.Caption = ""
  204.     MoveWord = " move."
  205.     Xb% = (NumberXSquares - 8) / 2
  206.     Yb% = (NumberYSquares - 6) / 2
  207.     If ScoreArray(Xb%, Yb%) = NoScore Then
  208.         BS$ = "None"
  209.     Else
  210.         BS$ = Str$(ScoreArray(Xb%, Yb%))
  211.     End If
  212.     MyMemory.FieldDesc.Caption = "Field is " + LTrim$(Str$(NumberXSquares)) + "x" + LTrim$(Str$(NumberYSquares)) + "    Score to Beat: " + BS$
  213.     MyMemory.MousePointer = DEFAULT
  214.  
  215. End Sub
  216.  
  217. Sub MyProfile ()
  218.     KeyWord$ = "NumberXSquares"
  219.     If GetPrivateProfileInt(SelectHeader, KeyWord$, -1, SelectMy) <> -1 Then
  220.         SaveFile = SelectSaveFileMy
  221.         IniFile = SelectMy
  222.         GetMyProfile
  223.     ElseIf GetPrivateProfileInt(SelectHeader, KeyWord$, -1, SelectWEP) <> -1 Then
  224.         SaveFile = SelectSaveFileWEP
  225.         IniFile = SelectWEP
  226.         GetMyProfile
  227.     ElseIf GetPrivateProfileInt(SelectHeader, KeyWord$, -1, SelectWIN) <> -1 Then
  228.         SaveFile = SelectSaveFileWIN
  229.         IniFile = SelectWIN
  230.         GetMyProfile
  231.     Else
  232.         SaveFile = SelectSaveFileNo
  233.     End If
  234.     SaveFileStart = SaveFile
  235.  
  236. End Sub
  237.  
  238. Sub ResizeMyMemoryForm ()
  239. 'Resize Form according to selected X, Y and squaresize
  240.     XField% = NumberXSquares * SquareSize
  241.     YField% = NumberYSquares * SquareSize
  242.     MyMemory.Width = XField% * TwipsPerPixel + FormBorder
  243.     
  244. 'We need to double label height for small X arrays
  245.     If NumberXSquares < 12 Then
  246.         MyMemory.LabelFieldStatus.Height = FormLabel * 2
  247.         MyMemory.LabelSquareStatus.Height = FormLabel * 2
  248.     ElseIf NumberXSquares > 10 Then
  249.         MyMemory.LabelFieldStatus.Height = FormLabel
  250.         MyMemory.LabelSquareStatus.Height = FormLabel
  251.     End If
  252.     
  253.     If NumberXSquares = 8 And SquareSize = 32 Then
  254.         MyMemory.FieldDesc.Height = FormLabel - 5
  255.         MyMemory.FieldDesc.FontSize = 9.75
  256.     Else
  257.         MyMemory.FieldDesc.Height = FormLabel
  258.         MyMemory.FieldDesc.FontSize = 12
  259.     End If
  260.  
  261. 'After determining label height we can set form height
  262.     MyMemory.Height = (YField% + MyMemory.LabelFieldStatus.Height + MyMemory.FieldDesc.Height) * TwipsPerPixel + FormHeader
  263.  
  264. 'Now set labels in correct position
  265.     Label2L% = XField% / 2
  266.     
  267.     MyMemory.FieldDesc.Top = YField%
  268.     MyMemory.FieldDesc.Left = 0
  269.     MyMemory.FieldDesc.Width = XField%
  270.     
  271.     MyMemory.LabelFieldStatus.Top = YField% + MyMemory.FieldDesc.Height
  272.     MyMemory.LabelFieldStatus.Left = Label2L%
  273.     MyMemory.LabelFieldStatus.Width = Label2L%
  274.     
  275.     MyMemory.LabelSquareStatus.Top = YField% + MyMemory.FieldDesc.Height
  276.     MyMemory.LabelSquareStatus.Left = 0
  277.     MyMemory.LabelSquareStatus.Width = Label2L%
  278.     
  279. End Sub
  280.  
  281. Sub SaveMyProfile ()
  282.  
  283.     If SaveFile = SelectSaveFileNo Or SaveFileChange = False Then Exit Sub
  284.  
  285.     Temp1% = WritePrivateProfileString(SelectHeader, "NumberXSquares", Str$(NumberXSquares), IniFile)
  286.     Temp2% = WritePrivateProfileString(SelectHeader, "NumberYSquares", Str$(NumberYSquares), IniFile)
  287.     Temp3% = WritePrivateProfileString(SelectHeader, "SquareSize", Str$(SquareSize), IniFile)
  288.     Temp4% = WritePrivateProfileString(SelectHeader, "Timer", Str$(SetTimer), IniFile)
  289.     Temp5% = WritePrivateProfileString(SelectHeader, "SaveBestScore", Str$(SaveScore), IniFile)
  290.  
  291.     If Temp1% = 0 Or Temp2% = 0 Or Temp3% = 0 Or Temp4% = 0 Or Temp5% = 0 Then
  292.         Msg$ = "Error Writing Profile - Check -> " + IniFile + NL
  293.         MsgBox Msg$, MB_OK, "Profile Error"
  294.     End If
  295.  
  296. End Sub
  297.  
  298. Sub SaveMyScore ()
  299.  
  300. 'Get array address for item
  301.     Xa% = (NumberXSquares - 8) / 2
  302.     Ya% = (NumberYSquares - 6) / 2
  303.  
  304. 'If old score, compare to new score
  305.     If CurrentMoves >= ScoreArray(Xa%, Ya%) Then Exit Sub
  306.     ScoreArray(Xa%, Ya%) = CurrentMoves
  307.  
  308. 'See if scores being saved
  309.     If SaveScore <> CHECKED Then Exit Sub
  310.  
  311. 'Now get name of person winning game
  312.     Msg$ = "You've Beaten the last Best Score!" + NL + NL + "Using " + Str$(CurrentMoves) + MoveWord
  313.     Msg$ = Msg$ + NL + NL + "Please enter your name: "
  314.     ScoreArrayName(Xa%, Ya%) = InputBox$(Msg$, "Your're a Winner!", "Name")
  315.  
  316. 'If new score beats old score or no old score then save new score
  317.     KeyWord$ = "Score" + LTrim$(Str$(NumberXSquares%)) + "x" + LTrim$(Str$(NumberYSquares%))
  318.     Temp% = WritePrivateProfileString(SelectHeader, KeyWord$, Str$(ScoreArray(Xa%, Ya%)), IniFile)
  319.     KeyWord$ = KeyWord$ + "Name"
  320.     Temp1% = WritePrivateProfileString(SelectHeader, KeyWord$, ScoreArrayName(Xa%, Ya%), IniFile)
  321.     If Temp% = 0 Or Temp1% = 0 Then
  322.         MsgBox "Error Writing Scores", MB_OK, "Profile Error"
  323.     End If
  324.  
  325. End Sub
  326.  
  327.